\ opg.3 of 3 97.11.04 Wil Baden
\ Included by opg.

( Determine what to do with the operator. )
: code-operation ( code -- )
  CASE 1  OF  0  -1 Parenthesis-Count +!  ENDOF
  2  OF  0  ENDOF
  3  OF  S" F+ "  ENDOF
  4  OF  S" F- "  ENDOF
  5  OF  S" F* "  ENDOF
  6  OF  S" F/ "  ENDOF
  7  OF  S" F** " ENDOF
  8  OF  S" FNEGATE "  ENDOF
  9  OF  Op-Pop Op-Top  Op-Pop Op-Top
  -1 Parenthesis-Count +!
  callable
  ENDOF
  DROP  TRUE ABORT" Invalid Operator "
  0 ENDCASE ( addr k)
  ?DUP ?? translate-operation
;

( Use operator precedence to select operators. )
: apply-operators ( str len -- str' len' )
  BEGIN  op-code ( str len code)
  DUP 2SWAP 2>R ( code code)( R: str len)
  >R operator-precedence >R ( )( R: . . . precedence)
  BEGIN  Op-Top operator-precedence R@ < NOT
  WHILE  Op-Top code-operation  Op-Pop
  REPEAT
  R> DROP R> 2R> ( code str len)( R: )
  DUP IF  1 /STRING  THEN
  ROT ( str len code)
  DUP Right-Paren =
  WHILE  DROP  Op-Pop  REPEAT
  ?DUP ?? op-push ( str' len')
;

( Pick up an operand and an operator. )
: translate-operand-operator ( str len -- str' len' )

 ( Is it a variable or function-call? )
  2DUP is-identifier IF ( a n a+k n-k)
  DUP ANDIF OVER C@ [CHAR] ( = THEN IF
  Op-Dummy op-push
  DUP >R 2SWAP R> - ( a+k n-k a k)
  op-push op-push Function-Call op-push ( a+k n-k)
  1 Parenthesis-Count +!
  1 /STRING
  ELSE
  2>R  R@ - op-fetch  2R>
  apply-operators
  THEN
  EXIT
  THEN 2DROP ( str len)

 ( Is it a number? )
  2DUP is-number IF ( a n a+k n-k)
  2>R  R@ - op-literal  2R>
  apply-operators
  EXIT
  THEN 2DROP ( str len)

 ( Is it a left paren? )
  OVER C@ [CHAR] ( = IF
  Op-Dummy op-push  Left-Paren op-push
  1 Parenthesis-Count +!
  1 /STRING
  EXIT
  THEN

 ( Is it a lonely minus sign? )
  OVER C@ [CHAR] - = IF
  Negation op-push
  1 /STRING
  EXIT
  THEN

 ( Is it a lonely plus sign? )
  OVER C@ [CHAR] + =  ANDIF DUP 1 > THEN  IF
  1 /STRING
  EXIT
  THEN

 ( Is it evaluate? )
  OVER C@ [CHAR] { = IF
  1 /STRING
  [CHAR] } split-at-char
  2SWAP 2>R  translate-operation  2R>
  DUP IF  1 /STRING  THEN
  apply-operators
  EXIT
  THEN

 ( Oops. )
  CR  TYPE  CR
  TRUE ABORT" Illegal Operand "
;

( `translate-expression`  Translate the expression. )
: translate-expression ( str len -- )
  BEGIN  DUP WHILE
  translate-operand-operator
  REPEAT  2DROP
  Parenthesis-Count @ ABORT" Unmatched Parens "
;

( `translate-formula`  Translate the formula. )
: translate-formula ( str len -- )
  0 Op-Stack !  0 Parenthesis-Count !

  2DUP is-identifier
  ANDIF DUP ANDIF OVER C@ [CHAR] = = THEN THEN IF
  DUP >R 2SWAP R> - op-push op-push -1 op-push
  1 /STRING
  translate-expression
  Op-Top -1 = NOT ABORT" Invalid Expression "
  Op-Pop Op-Top  Op-Pop Op-Top  op-store
  ELSE  2DROP
  -1 op-push
  translate-expression
  THEN

  Op-Stack @ 1 CELLS = NOT ABORT" Invalid Formula "
;

  255 CONSTANT Formula-Length
  CREATE Formula  Formula-Length 1+ CHARS ALLOT

  VARIABLE Keep-Spaces

: accept-char-for-formula ( str length char -- str length' )
  OVER Formula-Length > ABORT" Formula Length Overflow "
  CASE
  [CHAR] { OF  [CHAR] { replace-last-char  1+
  Keep-Spaces ON  ENDOF
  [CHAR] } OF  [CHAR] } replace-last-char  1+
  Keep-Spaces OFF ENDOF
  [CHAR] * OF  DUP ANDIF 2DUP 1- CHARS + C@ [CHAR] * = THEN
  IF  1- [CHAR] ^  ELSE  [CHAR] *  THEN
  replace-last-char  1+
  ENDOF
  replace-last-char  1+
  0 ENDCASE
;

: Get-Formula ( "multi-lines<colon>" -- addr len )
  Keep-Spaces OFF
  Formula 0 ( str length)
  BEGIN  GET-CHAR  DUP 0< ABORT" End of File " ( length char)
  DUP [CHAR] : = NOT
  WHILE  DUP BL > ORIF  DUP BL = Keep-Spaces @ AND THEN  IF
  accept-char-for-formula
  ELSE  DROP
  THEN ( str length)
  REPEAT DROP
;
public:
( `LET`  Translate `varname=expr` or `expr`. )
: LET ( "ccc<colon>" -- )( F: -- nothing or values )
  Get-Formula translate-formula
; IMMEDIATE
